home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / utils / imd110.zip / IMAGEID.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-12  |  12KB  |  433 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. UNIT ImageID;
  6.  
  7. (* A Pascal unit which will determine a few major image types.
  8.    To use this unit, simply call the function as follows:
  9.  
  10.    FileID := IsImage (FileName.Ext, width, height, colors, GIFlite);
  11.    IF FileID = 'wBMP' THEN ...
  12.  
  13. Returns a null string if unable to identify, otherwise one of these:
  14.  wBMP, GIF87a, GIF89a, JPEG, PCX, PiNG
  15.  
  16. *)
  17. INTERFACE
  18.  
  19. FUNCTION IsImage (CONST fFile: STRING; VAR iWidth, iHeight: LONGINT; VAR iColors, GIFLite: STRING): STRING;
  20.  
  21. VAR
  22.   ImageType : STRING;
  23.   ImageWidth : LONGINT;
  24.   ImageHeight : LONGINT;
  25.   ImageColors : STRING;
  26.   GIFl : STRING;
  27.  
  28. IMPLEMENTATION
  29.  
  30. FUNCTION LPad (bstr: STRING; CONST len: BYTE): STRING;
  31. BEGIN
  32.   WHILE (Length (bstr) < len) DO
  33.     bstr := #32 + bstr;
  34.   LPad := bstr;
  35. END;
  36.  
  37. FUNCTION GetBMPInfo (CONST FName: STRING): BOOLEAN;
  38. { This procedure takes the name of an existing file as input, and tries
  39.   to write the header contents of the file on screen. }
  40. TYPE
  41.   BMPheader =
  42.   RECORD
  43.     bfType :             WORD;
  44.     bfSize :             LONGINT;
  45.     bfReserved :         LONGINT;     {Moet 0 zijn}
  46.     bfOffBits :          LONGINT;
  47.     biSize :             LONGINT;
  48.     biWidth :            LONGINT;
  49.     biHeight :           LONGINT;
  50.     biPlanes :           WORD;        {Moet 1 zijn}
  51.     biBitCount :         WORD;        {1,4,8,24}
  52.     biCompression :      LONGINT;
  53.     biSizeImage :        LONGINT;     {in bytes}
  54.     biXPelsPerMeter :    LONGINT;
  55.     biYPelsPerMeter :    LONGINT;
  56.     biClrUsed :          LONGINT;
  57.     biClrImportant :     LONGINT;
  58.   END;
  59.  
  60. LABEL
  61.   SkipBMP;
  62.  
  63. VAR
  64.   ImageFile: FILE;
  65.   BitMapHeader : BMPheader;
  66.   Colors : STRING[4];
  67.   BytesRead : WORD;
  68.   IsBMP : BOOLEAN;
  69.  
  70. BEGIN
  71.   IsBMP := FALSE;
  72.   Assign (ImageFile, FName);
  73.   Reset (ImageFile, 1);
  74.   BlockRead (ImageFile, BitMapHeader, SizeOf (BitMapHeader), BytesRead);
  75.   Close (ImageFile);
  76.   IF (IOResult = 0) AND (BytesRead = SizeOf(BitMapHeader)) THEN
  77.   WITH BitMapHeader DO
  78.   BEGIN
  79.     IF NOT (bfType = 19778) OR ((bfReserved <> 0) AND (biPlanes <> 1)) THEN
  80.       Goto SkipBMP;
  81.  
  82.     CASE (biBitCount) OF
  83.       1 : Colors := '2';
  84.       4 : Colors := '16';
  85.       8 : Colors := '256';
  86.       24: Colors := '16m'; {2^24}
  87.       ELSE
  88.         Goto SkipBMP;
  89.     END;
  90.     IsBMP := TRUE;
  91.     IF biClrUsed <> 0 THEN
  92.       Str (biClrUsed, Colors);
  93.  
  94.     ImageType := 'wBMP';
  95.     ImageWidth := biWidth;
  96.     ImageHeight := biHeight;
  97.     ImageColors := (LPad(colors,5))+' ]';
  98.  
  99.   END;
  100.   SkipBMP:
  101.   GetBMPInfo := IsBMP;
  102. END;
  103.  
  104. PROCEDURE CheckGIFlite (CONST fname: STRING; FPos: LONGINT; OFFSET: WORD);
  105. VAR
  106.   giflite: ARRAY [1..7] OF CHAR;
  107.   blocklabel: ARRAY [1..2] OF CHAR;
  108.   ImageFile: FILE;
  109.   BytesRead : WORD;
  110.  
  111. BEGIN
  112.   Assign (ImageFile, fname);
  113.   Reset (ImageFile, 1);
  114.   FillChar (giflite [1], SizeOf(giflite), #32);
  115.   FillChar (blocklabel [1], SizeOf(blocklabel), #32);
  116.   Seek (ImageFile, FPos + (3 * OFFSET));
  117.   IF (IOResult = 0) THEN
  118.   BEGIN
  119.     BlockRead (ImageFile, blocklabel, SizeOf(blocklabel), BytesRead);
  120.     IF (IOResult = 0) AND (BytesRead = SizeOf(blocklabel)) AND (blocklabel = #33#255) THEN BEGIN
  121.       Seek (ImageFile, FilePos(ImageFile) + 1);
  122.       BlockRead (ImageFile, giflite, SizeOf(giflite), BytesRead);
  123.     END;
  124.   END;
  125.   Close (ImageFile);
  126.   IF (IOResult = 0) AND (BytesRead = SizeOf(giflite)) AND (giflite = 'GIFLITE')
  127.     THEN GIFl := '(LITE)';
  128. END;
  129.  
  130. FUNCTION GetGIFInfo (CONST FName: STRING): BOOLEAN;
  131. TYPE
  132.   Image_Rec = RECORD
  133.                 i_version : ARRAY [1..6] OF CHAR;
  134.                 i_width,
  135.                 i_height : WORD;
  136.                 i_colors : BYTE;
  137.               END;
  138.  
  139. VAR
  140.   ImageData: Image_Rec;
  141.   ImageFile: FILE;
  142.   rez : WORD;
  143.   FPos: LONGINT;
  144.   BytesRead : WORD;
  145.   IsGIF: BOOLEAN;
  146.  
  147. BEGIN
  148.   IsGIF := FALSE;
  149.   Assign (ImageFile, FName);
  150.   Reset (ImageFile, 1);
  151.   IF (IOResult = 0) THEN
  152.   BEGIN
  153.     BlockRead (ImageFile, ImageData, SizeOf (ImageData), BytesRead);
  154.     FPos := FilePos (ImageFile);
  155.     Close (ImageFile);
  156.     IF (IOResult = 0) AND (BytesRead = SizeOf (ImageData)) THEN
  157.       WITH ImageData DO BEGIN
  158.         IF (Copy (i_version, 1, 3) = 'GIF') THEN
  159.         BEGIN
  160.           IsGIF := TRUE;
  161.           rez := (2 SHL (i_colors AND 7));  {formula from SWAG}
  162.  
  163.           ImageType := i_version;
  164.           ImageWidth := i_Width;
  165.           ImageHeight := i_Height;
  166.           Str (rez:5,ImageColors);
  167.           ImageColors := ImageColors + ' ]';
  168.  
  169.           CheckGIFlite (FName, FPos+2, rez) {FPos+2 accounts for "background"}
  170.         END;
  171.       END;
  172.   END;
  173.   GetGIFInfo := IsGIF;
  174. END;
  175.  
  176. FUNCTION GetJPGInfo (CONST FName: STRING): BOOLEAN;
  177. {Checks if file FName is a (true) JPeg/JFIF file and extracts the
  178.  height and width (in pixels) of the image, and determines if image is color}
  179.  
  180. VAR
  181.   ImageFile : FILE;
  182.   ImageData : ARRAY [1..11] OF CHAR;
  183.   BytesRead : WORD;
  184.   Index : INTEGER;
  185.   Height, Width, Color: WORD;
  186.   IsJPG : BOOLEAN;
  187.   BlockLength : LongInt;
  188.  
  189. BEGIN
  190.   IsJPG := FALSE;
  191.  
  192.   Assign (ImageFile, FName);
  193.   Reset (ImageFile, 1);
  194.  
  195.   FillChar (ImageData [1], SizeOf(ImageData), #0);
  196.   BlockRead (ImageFile, ImageData [1], SizeOf(ImageData), BytesRead);
  197.  
  198.   IF (IOResult = 0) AND
  199.      (BytesRead = SizeOf(ImageData)) AND
  200.      (ImageData [1]  = #$FF) AND   {JFIF marker: $FF SOI $FF App0}
  201.      (ImageData [2]  = #$D8) AND
  202.      (ImageData [3]  = #$FF) AND
  203.      (ImageData [4]  = #$E0) AND
  204.    { (ImageData [5]  = length - MSB and }
  205.    { (ImageData [6]  = length - LSB and }
  206.      (ImageData [7]  = 'J') AND
  207.      (ImageData [8]  = 'F') AND
  208.      (ImageData [9]  = 'I') AND
  209.      (ImageData [10] = 'F') AND
  210.      (ImageData [11] = #0)
  211.   THEN IsJPG := TRUE;
  212.  
  213.   IF IsJPG THEN
  214.   BEGIN {We have a JPeg/JFIF File!}
  215.  
  216.     Seek(ImageFile, 4); {Restore to position right after first block sig}
  217.     BlockLength := 256*Ord(ImageData[5]) + Ord(ImageData[6]);
  218.  
  219.     REPEAT   {Search for SOF marker}
  220.  
  221.       Seek (ImageFile, FilePos(ImageFile) + BlockLength);
  222.  
  223.       BlockRead (ImageFile, ImageData [1], 4, BytesRead);
  224.       BlockLength := 256*Ord(ImageData[3]) + Ord(ImageData[4]) - 2;
  225.  
  226.     UNTIL (BytesRead <> 4) OR (ImageData [2] = #$C0);
  227.  
  228.     IF ImageData[2]=#$C0 THEN BEGIN
  229.       Seek (ImageFile, FilePos(ImageFile) - 2);
  230.       BlockRead (ImageFile, ImageData [1], SizeOf(ImageData), BytesRead);
  231.  
  232.       IF BytesRead = SizeOf(ImageData) THEN
  233.       BEGIN
  234.         Index := 0;
  235.       { ImageData[Index] = first SOF marker
  236.         Index + 1 = length high byte  \ length of APP0 data!
  237.         Index + 2 = length low byte   /
  238.         Index + 3 = data precision    - colors (?)
  239.         Index + 4 = height high byte  \ heigth of picture
  240.         Index + 5 = height low byte   /
  241.         Index + 6 = width high byte   \ width of picture
  242.         Index + 7 = width low byte    / }
  243.  
  244.         Height := WORD (Ord (ImageData [Index + 4]) * 256) + Ord (ImageData [Index + 5]);
  245.         Width  := WORD (Ord (ImageData [Index + 6]) * 256) + Ord (ImageData [Index + 7]);
  246.         Color  := Ord (ImageData [Index + 8]);
  247.       END;
  248.     END;
  249.   END;
  250.   IF IsJPG THEN
  251.     BEGIN
  252.  
  253.       ImageType := 'JPEG';
  254.       ImageWidth := Width;
  255.       ImageHeight := Height;
  256.       IF Color > 1
  257.         THEN ImageColors := (' color]')
  258.         ELSE ImageColors := (' grey ]');
  259.  
  260.     END;
  261.   Close (ImageFile);
  262.   GetJPGInfo := IsJPG;
  263. END;
  264.  
  265. PROCEDURE Swap32 (VAR LongVar : LONGINT); ASSEMBLER;
  266. ASM {Swap a 32 bit variable (MSB<->LSB).}
  267.   les     SI, LongVar
  268.   mov     AX, ES: [SI]
  269.   mov     DX, ES: [SI + 2]
  270.   xchg    AL, DH
  271.   xchg    AH, DL
  272.   mov     ES: [SI], AX
  273.   mov     ES: [SI + 2], DX
  274. END {Swap32};
  275.  
  276. PROCEDURE Process_IHDR (VAR ImageFile: FILE);
  277. VAR
  278.   PNGHead : RECORD {see the PNG spec, draft #9}
  279.               Width, Height  : LONGINT;
  280.               BitsPerSample  : BYTE;
  281.               ColorType      : BYTE;
  282.               CM, Filter, IL : BYTE
  283.             END;
  284.   Colors : String[3];
  285.   BytesRead : WORD;
  286.  
  287. BEGIN {Process_IHDR}
  288.   FillChar (PNGHead, SizeOf (PNGHead), #0);
  289.   BlockRead (ImageFile, PNGHead, SizeOf (PNGHead), BytesRead);
  290.   IF (IOResult = 0) AND (BytesRead = SizeOf (PNGHead)) THEN
  291.   WITH PNGHead DO BEGIN
  292.     Swap32 (Width);
  293.     Swap32 (Height);
  294.     CASE (BitsPerSample) OF
  295.       1 : Colors := '2';
  296.       4 : Colors := '16';
  297.       8 : Colors := '256';
  298.       24: Colors := '16m'; {2^24}
  299.      ELSE Colors := '???'
  300.     END;
  301.  
  302.       ImageType := 'PiNG';
  303.       ImageWidth := Width;
  304.       ImageHeight := Height;
  305.       IF ColorType > 1
  306.         THEN ImageColors := LPad(colors,5)+'c]'
  307.         ELSE ImageColors := LPad(colors,5)+'g]';
  308.  
  309.   END;
  310. END {Process_IHDR};
  311.  
  312. FUNCTION GetPNGInfo (CONST Fname: STRING): BOOLEAN;
  313. CONST
  314.   PNG_Magic : ARRAY [0..7] OF CHAR = #137'PNG'#13#10#26#10;
  315.   MaxBytes = 1000;
  316.  
  317. VAR
  318.   BufMag    : ARRAY [0..7] OF CHAR;
  319.   ImageFile : FILE;
  320.   ImageData : ARRAY [1..MaxBytes] OF CHAR;
  321.   BytesRead : WORD;
  322.   Index : INTEGER;
  323.   Found,
  324.   IsPNG : BOOLEAN;
  325.  
  326. BEGIN
  327.   IsPNG := FALSE;
  328.   Assign (ImageFile, FName);
  329.   Reset (ImageFile, 1);
  330.   BlockRead (ImageFile, BufMag, SizeOf(BufMag), BytesRead);
  331.   IF (IOResult = 0) AND (BytesRead = SizeOf(BufMag)) THEN
  332.   BEGIN
  333.     IF (BufMag = PNG_Magic) THEN
  334.     BEGIN
  335.       BlockRead (ImageFile, ImageData [1], MaxBytes, BytesRead);
  336.       index := 0;
  337.       Found := FALSE;
  338.       REPEAT
  339.         Inc (index);
  340.         IF (ImageData [index]   = 'I') AND
  341.            (ImageData [index+1] = 'H') AND
  342.            (ImageData [index+2] = 'D') AND
  343.            (ImageData [index+3] = 'R')
  344.         THEN FOUND := TRUE;
  345.       UNTIL Found OR (index + 10 > BytesRead);
  346.       If Found Then Begin
  347.         IsPNG := TRUE;
  348.         Seek(ImageFile, Index+3+SizeOf(BufMag));  {Seek is zero based}
  349.         Process_IHDR (ImageFile);
  350.       End;
  351.     END;
  352.   END;
  353.   Close (ImageFile);
  354.   GetPNGInfo := IsPNG;
  355. END {Main};
  356.  
  357. FUNCTION GetPCXInfo (CONST FName: STRING): BOOLEAN;
  358. TYPE
  359.   PCXHeader = RECORD
  360.                 Signature    : CHAR;
  361.                 Version      : CHAR;
  362.                 Encoding     : CHAR;
  363.                 BitsPerPixel : CHAR;
  364.                 XMin, YMin,
  365.                 XMax, YMax   : INTEGER;
  366.                 HRes, VRes   : INTEGER;
  367.                 Palette      : ARRAY [0..47] OF BYTE;
  368.                 Reserved     : CHAR;
  369.                 Planes       : CHAR;
  370.                 BytesPerLine : INTEGER;
  371.                 PALETTETYPE  : INTEGER;
  372.                 Filler       : ARRAY [0..57] OF BYTE;
  373.               END;
  374.  
  375. VAR
  376.   header: PCXHeader;
  377.   width, depth: WORD;
  378.   colors: WORD;
  379.   ImageFile: FILE;
  380.   BytesRead : WORD;
  381.   IsPCX : BOOLEAN;
  382.  
  383. BEGIN
  384.   IsPCX := FALSE;
  385.   Assign (ImageFile, FName);
  386.   Reset (ImageFile, 1);
  387.   BlockRead (ImageFile, header, SizeOf (header), BytesRead);
  388.   Close (ImageFile);
  389.   IF (IOResult = 0) AND (BytesRead = SizeOf (header)) THEN
  390.   WITH header DO
  391.     IF (Signature = #10) AND (Ord(Version) in [0,2,3,4,5]) THEN
  392.     BEGIN
  393.       IsPCX := TRUE;
  394.       width := XMax - XMin + 1;
  395.       depth := YMax - YMin + 1;
  396.       colors := 1 SHL (Ord(Planes)*Ord(BitsPerPixel));
  397.  
  398.       ImageType := 'PCX';
  399.       ImageWidth := Width;
  400.       ImageHeight := Depth;
  401.       Str (colors:5, ImageColors);
  402.       ImageColors := ImageColors + ' ]';
  403.  
  404.     END;
  405.   GetPCXInfo := IsPCX;
  406. END;
  407.  
  408. FUNCTION IsImage (CONST fFile: STRING; VAR iWidth, iHeight: LONGINT; VAR iColors, GIFLite: STRING): STRING;
  409. BEGIN
  410.   ImageType := '';
  411.   ImageWidth := 0;
  412.   ImageHeight := 0;
  413.   ImageColors := '';
  414.   GIFl := '';
  415.  
  416.   IF GetGIFInfo (fFile)
  417.    OR GetJPGInfo (fFile)
  418.     OR GetBMPInfo (fFile)
  419.      OR GetPNGInfo (fFile)
  420.       OR GetPCXInfo (fFile)
  421.       THEN BEGIN
  422.         iWidth := ImageWidth;
  423.         iHeight := ImageHeight;
  424.         iColors := ImageColors;
  425.         GIFlite := Gifl;
  426.       END;
  427.   IsImage := ImageType;
  428. END;
  429.  
  430. (*****************************************************************************)
  431.  
  432. END.
  433.